COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE LSPTRG - LISP TRIG FUNCTIONS - BGB - 7 APRIL 1973.
C00005 00003	ACOS(X)= π/2 - ASIN(X).
C00006 00004	SUBR(LOG)
C00007 00005	SUBR(RANDO)
C00009 00006	SUBR(SQRT)
C00011 00007	ATAN(X) = X*(B0+A1 / (Z+B1-A2 / (Z+B2-A3 / (Z+B3))) )
C00014 ENDMK
C⊗;
TITLE LSPTRG - LISP TRIG FUNCTIONS - BGB - 7 APRIL 1973.
	EXTERN NUMVAL,MAKNUM

;ALTERNATE PDP-10 MNEMONICS.
	OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF GO[JRST]
	OPDEF LACM[MOVM]↔OPDEF LACN[MOVN]↔OPDEF DAP[HRRM]
;LISP CONVENTIONS.
	DEFINE SUBR(NAME){INTERN NAME↔NAME:}
	DEFINE ARG1<1>
	DEFINE ARG2<2>
	DEFINE POP1J<GO POP1J.>
	DEFINE POP2J<GO POP2J.>

	HALFPI:	201622077325 ;PI/2
	PI:	202622077325

INTERN SIN,COS
BEGIN SINCOS
	A←1 ↔ B←2 ↔ C←3
↑COS:	PUSHJ 14,NUMVAL
	HRLI 2,(<MOVEI 2,>)↔CAME 2,MAKNUM+2↔GO[FSC 1,233
	FMPR 1,[0.017453292]↔GO .+1]
	FADR A,HALFPI↔GO SIN+4	;COS(X) = SIN(X+π/2).
↑SIN:	PUSHJ 14,NUMVAL
	HRLI 2,(<MOVEI 2,>)↔CAME 2,MAKNUM+2↔GO[FSC 1,233
	FMPR 1,[0.017453292]↔GO .+1]
	MOVM B,A↔CAMG B,[17B5]↔POP1J	;FOR SMALL X, SIN(X)=X.

;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
	FDVR B,HALFPI
	LAC C,B↔FIX C,233000
	CAILE C,3↔GO[
	TRZ C,3↔FSC C,233
	FSBR B,C↔GO .-3]		;MODULO 2π.
	GO .+1(C)↔GO .+4↔JFCL↔GO[
	FSBRI B,(2.0)↔MOVNS B↔GO .+2]	;SIN(X+π)=SIN(-X)
	FSBRI B,(4.0)			;SIN(X+2π)=SIN(X)
	SKIPGE A↔MOVNS	B		;SIN(-X) = -SIN(X).

;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
	DAC B,C↔FMPR B,B	
	LAC A,[164475536722]↔FMP A,B
	FAD A,[606315546346]↔FMP A,B
	FAD A,[175506321276]↔FMP A,B
	FAD A,[577265210372]↔FMP A,B
	FAD A,HALFPI↔FMPR A,C↔POP1J
	LIT
BEND
;ACOS(X)= π/2 - ASIN(X).
;GIVEN -1 ≤ X ≤ +1 RETURN 0 ≤ ACOS(X) ≤ +π.
SUBR(ACOS)
BEGIN ACOS
	PUSHJ 14,ASIN
	PUSHJ 14,NUMVAL
	MOVNS 1↔FADR 1,HALFPI
	POP1J
BEND

;ASIN(X)=ATAN(X/SQRT(1-X↑2)).
;GIVEN -1 ≤ X ≤ +1 RETURN -π/2 ≤ ASIN(X) ≤ +π/2.
SUBR(ASIN)
BEGIN ASIN
	A←1 ↔ B←2
	PUSH 14,NUMVAL
	LACN A,ARG1↔FMPR A,ARG1↔FADRI A,(1.0)
	JUMPE A,[		;WAS X EITHER -1.0 OR 1.0?
		LAC A,HALFPI
		SKIPGE ARG1
		MOVNS A↔POP1J]
	PUSHJ 14,SQRT↔PUSHJ 14,NUMVAL
	LAC B,ARG1↔FDVR B,1↔DAC B,ARG1	;CALCULATE X/SQRT(1-X↑2)
	GO ATAN+1		;CALCULATE ATAN(SQRT(1-X↑2))
BEND

SUBR(LOG)
BEGIN LOG
	PUSHJ 14,NUMVAL
	HRLI 2,(<MOVEI 2,>)↔CAME 2,MAKNUM+2↔FSC 1,233
	MOVM 2,ARG1↔SKIPE 1,2↔CAMN 2,[1.0]↔POP1J
	ASHC 2,-33↔DAC 3,1
	ADDI 2,211000↔MOVSM 2,TMP1#
	MOVSI 2,(-128.5)↔FADM 2,TMP1
	ASH 1,-10↔TLC 1,200000↔FAD 1,[-0.70710678]
	LAC 2,1↔FAD 2,[1.4142135]↔FDV 1,2
	DAC 1,TMP2#↔FMP 1,1
	LAC 2,[0.59897864]↔FMP 2,1
	FAD 2,[0.96147063]↔FMP 2,1
	FAD 2,[2.88539120]↔FMP 2,TMP2↔FAD 2,TMP1
	FMP 2,[0.69314718]↔LAC 1,2↔POP1J
	LIT↔VAR
BEND

SUBR(RANDO)
BEGIN RANDO
;	PUSHJ 14,NUMVAL↔HRLI 2,(<MOVEI 2,>)
;	CAME 2,MAKNUM+2↔FSC 1,233		;INTEGER INPUT ?
;	MOVMM 1,RAN0

	SKIPE RANFLG↔GO L1↔SETOM RANFLG
	HRLZI 1,-=256↔MOVEI 3
	IMULI 3↔AND[017777777777]	;RAN5[I] ← RAN2 ←(RAN2*3)MOD 2↑31.
	DAC RAN5(1)↔AOBJN 1,.-3
	DAC RAN2
L1:
	MOVE 1,RAN2↔MULI 1,=1756↔IDIVI 2,=8191↔DAC 3,RAN1

	MOVE 1,RAN1↔ASH 1,-5
	CAILE 1,=256↔ANDI 1,377↔DAC 1,RAN3

	MOVE RAN5(1)↔DAC RAN4			;RAN4 ← RAN5[RAN3];

	MOVE RAN2
	IMULI 3↔AND[017777777777]	;RAN5[I] ← RAN2 ←(RAN2*3)MOD 2↑31.
	DAC RAN5(1)↔DAC RAN2
	LAC 1,RAN4
	ASH 1,-5↔FSC 1,200↔FMPR 1,RAN0
	FIX 1,233000
;	HRRZ 2,MAKNUM		;INTEGER RESULTS.
	POPJ 17,
RANFLG:	0
RAN0:	100.0
RAN1:	1
RAN2:	3
RAN3:	0
RAN4:	0
RAN5:	BLOCK =256
	LIT
BEND RANDO
SUBR(SQRT)
BEGIN	SQRT
	A←1 ↔ B←2 ↔ C←3
	PUSHJ 14,NUMVAL
	HRLI 2,(<MOVEI 2,>)↔CAME 2,MAKNUM+2↔FSC 1,233
	LACM B,ARG1
	JUMPE B,POP1J.

;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
	ASHC B,-=27↔SUBI B,201	;GET EXPONENT IN B, FRACTION IN C.
	ROT B,-1		;CUT EXP IN HALF, SAVE ODD BIT
	DAP B,L↔LSH B,-=35	;USE THAT ODD BIT.
	ASH C,-10↔FSC C,177(B)	;0.25 < FRACTION < 1.00

;LINEAR APPROXIMATION TO SQRT(F).
	DAC C,A
	FMP C,[0.8125↔0.578125](B)
	FAD C,[0.302734↔0.421875](B)

;TWO ITERATIONS OF NEWTON'S METHOD.
	LAC B,A
	FDV B,C↔FAD C,B↔FSC C,-1
	FDV A,C↔FADR A,C↔L: FSC A,0
↑POP1J.: GO MAKNUM+2
	LIT
BEND
;ATAN(X) = X*(B0+A1 / (Z+B1-A2 / (Z+B2-A3 / (Z+B3))) )
;WHERE Z=X↑2, IF 0<X<=1
;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;IF X>1, THEN RH(D) =-1, AND LH(D) = -SGN(X)
;IF X<1, THEN RH(D) = 0, AND LH(D) =  SGN(X)
SUBR(ATAN)
BEGIN ATAN
	A←1 ↔ B←2 ↔ C←3 ↔ D←4 ↔ E←5 ↔ P←17
	PUSHJ 14,NUMVAL		;PICK UP THE ARGUMENT IN A
ATAN1:	LACM	B, A		;GET ABSF OF ARGUMENT
	CAMG	B, A1		;IF X<2↑-33, THEN RETURN WITH...
	POP1J		;ATAN(X) = X
	HLLO	D, A		;SAVE SIGN, SET RH(D) = -1
	CAML	B, A2		;IF A>2↑33, THEN RETURN WITH
	GO[LAC A,HALFPI ↔POP1J];	ATAN(X) = PI/2
	MOVSI	C, 201400	;FORM 1.0 IN C
	CAMG	B, C		;IS ABSF(X)>1.0?
	TRZA	D, -1		;IF B ≤ 1.0, THEN RH(D) = 0
	FDVM	C, B		;B IS REPLACED BY 1.0/B
	TLC	D, (D)		;XOR SIGN WITH > 1.0 INDICATOR

	DAC B,E↔FMP B,B
	LAC C,B↔FAD C,KB3↔LAC A,KA3↔FDVM A,C
	FAD C,B↔FAD C,KB2↔LAC A,KA2↔FDVM A,C
	FAD C,B↔FAD C,KB1↔LAC A,KA1↔FDV  A,C
	FAD A,KB0↔FMP A,E

	TRNE	D, -1		;CHECK > 1.0 INDICATOR
	FSB	A, HALFPI		;ATAN(A) = -(ATAN(1/A)-PI/2)
	SKIPGE	D		;LH(D) = -SGN(B) IF B>1.0
	MOVNS A		;NEGATE ANSWER
	POP1J		;EXIT
A1:	145000000000		;2↑-33
A2:	233000000000		;2↑33

KB0:	176545543401		;0.1746554388
KB1:	203660615617		;6.762139240
KB2:	202650373270		;3.316335425
KB3:	201562663021		;1.448631538

KA1:	202732621643		;3.709256262
KA2:	574071125540		;-7.106760045
KA3:	600360700773		;-0.2647686202
BEND
END
LSPTRG.FAI - EOF.